home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Applications / Alpha.5.96 folder / Tcl / SystemCode / modes.tcl~ < prev    next >
Encoding:
Text File  |  1994-08-30  |  18.4 KB  |  711 lines  |  [TEXT/ALFA]
  1. # New modes can be specified by appending to the following vars.
  2. # are no longer any procs such as 'setTextMode' etc.
  3.  
  4. # 'mode' is nothing when we start up.
  5. set mode ""
  6.  
  7. set whichInfo mode
  8.  
  9. #================================================================================
  10. # The next two procs are called by Alpha to handle the mode flags popup menu.
  11. #================================================================================
  12.  
  13. proc getModeValuesAlpha {} {
  14.     global mode
  15.     global ${mode}modeVars
  16.     global allFlags
  17.     global whichInfo
  18.     set fvals {}
  19.     set vvals {}
  20.  
  21.     if {$whichInfo == "mode"} {
  22.         if {[info exists ${mode}modeVars]} {
  23.             set vars [lsort [array names ${mode}modeVars]]
  24.             foreach v $vars {
  25.                 if {[lsearch $allFlags $v] >= 0} {
  26.                     lappend fvals $v [set ${mode}modeVars($v)]
  27.                 } else {
  28.                     lappend vvals $v 0
  29.                 }
  30.             }
  31.         }
  32.         return [concat $fvals {-} 0 $vvals {{(-} 0 "Change List…" 0 "Set Mode Menus…" 0 "Describe Mode" 0 {(-} 0 "(Mode Info" 0 "File Info" 0}]
  33.     } else {
  34.         getWinInfo blah
  35.         lappend m "Mac" [expr {$blah(platform) == "mac"}]
  36.         lappend m "UNIX" [expr {$blah(platform) == "unix"}]
  37.         lappend m "IBM" [expr {$blah(platform) == "ibm"}] {(-} 0
  38.         lappend m "MPW" [expr {$blah(state) == "mpw"}]
  39.         lappend m "Think" [expr {$blah(state) == "think"}]
  40.         lappend m "None" [expr {$blah(state) == "none"}] {(-} 0
  41.         lappend m "Read Only" $blah(read-only) {(-} 0
  42.         lappend m "Mode Info" 0 "(File Info" 0
  43.         return $m
  44.     }
  45. }
  46.  
  47.  
  48. proc setModeVarAlpha {var} {
  49.     global mode allFlags modeVars modifiedModeVars
  50.     global whichInfo
  51.     global ${mode}modeVars
  52.     
  53.     if {$whichInfo == "file"} {
  54.         set var [string tolower $var]
  55.         switch $var {
  56.             "unix"        -
  57.             "mac"        -
  58.             "ibm"        { setWinInfo platform $var }
  59.             "mpw"        -
  60.             "think"        -
  61.             "none"        { setWinInfo state $var }
  62.             "mode info"    { set whichInfo mode }
  63.             "read only"    { 
  64.                 getWinInfo b
  65.                 setWinInfo read-only [expr -1 * ($b(read-only) - 1)]}
  66.         }
  67.         return
  68.     }
  69.             
  70.     if {$var == "Set Mode Menus…"} {
  71.         setModeMenus
  72.     } elseif {$var == "File Info"} {
  73.         set whichInfo file
  74.     } elseif {$var == "Mode Info"} {
  75.         set whichInfo mode
  76.     } elseif {$var == "Change List…"} {
  77.         set mvars {}
  78.         catch {set mvars [array names ${mode}modeVars]}
  79.         set vars [listpick -l -L $mvars -p "Set mode vars for '$mode':" [lsort $modeVars]]
  80.         if {![string length $vars]} return
  81.         
  82.         catch {unset ${mode}modeVars}
  83.         foreach v $vars {
  84.             global $v
  85.             set ${mode}modeVars($v) [set $v]
  86.         }
  87.     } elseif {$var == "Describe Mode"} {
  88.         describeMode
  89.     } elseif {[lsearch $allFlags $var] >= 0} {
  90.         global $var
  91.         set ${mode}modeVars($var) [set $var [expr -1 * ([set ${mode}modeVars($var)] - 1)]]
  92.         lappend modifiedModeVars [list $var ${mode}modeVars]
  93.     } else {
  94.         global $var
  95.         set res [prompt "New value of '$var':" [set ${mode}modeVars($var)]]
  96.         set ${mode}modeVars($var) $res
  97.         set $var $res
  98.         lappend modifiedModeVars [list $var ${mode}modeVars]
  99.     }
  100. }
  101.  
  102. #================================================================================
  103.  
  104.  
  105. # Suffixes used to initially determine mode for new window.
  106. set modeSuffixes { default { set winMode Text } }
  107.  
  108.  
  109. # The set of menus that the modes may choose to use.
  110. set allModeMenus {     thinkMenu cwarrierMenu toolserverMenu
  111.                     latexMenu thinkRefMenu tclMenu perlMenu }
  112.  
  113. set modeVars { elecLBrace elecRBrace electricSemi fillColumn funcExpr 
  114.     funcPar leftFillColumn optionIsMeta prefixString suffixString 
  115.     tabSize wordBreak wordBreakPreface wordWrap
  116. }
  117.  
  118.  
  119. # The dummy proc for a mode is called whenever we change to that mode,
  120. # so that the autoloading facility will load the correct file, if
  121. # necessary.
  122.  
  123. # The list of modes.
  124. set modes         {}
  125. set lastMode     0
  126.  
  127. # Can be used to add new mode-specific flags and variables (see think.tcl for example).
  128. proc newModeVar {mode var val isFlag} {
  129.     global ${mode}modeVars modeVars allFlags $var
  130.     
  131.     if {![info exists modeVars] || [lsearch $modeVars $var] < 0} {
  132.         lappend modeVars $var
  133.     }
  134.     if {![info exists ${mode}modeVars($var)]} {
  135.         set ${mode}modeVars($var) $val
  136.         set $var $val
  137.     }
  138.     if {$isFlag && (![info exists allFlags] || ([lsearch $allFlags $var] < 0))} {
  139.         lappend allFlags $var
  140.     }
  141. }
  142.  
  143. #================================================================================
  144. lappend modes C
  145. set dummyProc(C)                dummyC
  146. set modeMenus(C)                 { thinkMenu cwarrierMenu thinkRefMenu }
  147. lappend modeSuffixes             {*.h} { set winMode C }
  148. lappend modeSuffixes            {*.c} { set winMode C }
  149. lappend modeSuffixes            {*.r} { set winMode C }
  150. newModeVar C elecRBrace {1} 1
  151. newModeVar C prefixString {//} 0 
  152. newModeVar C electricSemi {1} 1
  153. newModeVar C wordBreak {[a-zA-Z0-9_]+} 0
  154. newModeVar C elecLBrace {1} 1
  155. newModeVar C wordWrap {0} 1
  156. newModeVar C funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  157. newModeVar C wordBreakPreface {[^a-zA-Z0-9_]} 0
  158. newModeVar C optionIsMeta {1} 1
  159. newModeVar C electricTab {0} 1
  160.  
  161. set cCommentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
  162. set cPreRegexp        {^\#[\t ]*[a-z]*}
  163. set cKeyWords        {
  164.     void register short enum extern int for if while struct static long 
  165.     switch case char unsigned double float return else default goto
  166. }
  167. regModeKeywords -e {//} -b {/*} {*/} -c red -k blue C $cKeyWords
  168.  
  169. #================================================================================
  170. lappend modes C++
  171. set dummyProc(C++)                dummyC++
  172. set modeMenus(C++)                 { thinkMenu cwarrierMenu thinkRefMenu }
  173. lappend modeSuffixes             {*.h} { set winMode C++ }
  174. lappend modeSuffixes            {*.cc} { set winMode C++ }
  175. lappend modeSuffixes            {*.cp} { set winMode C++ }
  176. lappend modeSuffixes            {*.cpp} { set winMode C++ }
  177. lappend modeSuffixes            {*.CPP} { set winMode C++ }
  178. lappend modeSuffixes            {*.C} { set winMode C++ }
  179. newModeVar C++ elecRBrace {1} 1
  180. newModeVar C++ prefixString {//} 0
  181. newModeVar C++ electricSemi {1} 1
  182. newModeVar C++ wordBreak {[a-zA-Z0-9_]+} 0
  183. newModeVar C++ elecLBrace {1} 1
  184. newModeVar C++ wordWrap {0} 1
  185. newModeVar C++ funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  186. newModeVar C++ wordBreakPreface {[^a-zA-Z0-9_]} 0
  187. newModeVar C++ optionIsMeta {1} 1
  188. newModeVar C++ electricTab {1} 1
  189.  
  190. regModeKeywords -e {//} -b {/*} {*/} -c red -k blue {C++} [concat {
  191.     new delete class friend protected private public template } $cKeyWords]
  192. unset cKeyWords
  193.  
  194. #================================================================================
  195. lappend modes Csh
  196. set dummyProc(Csh)                dummyCsh
  197. set modeMenus(Csh)             { tclMenu }
  198. lappend modeSuffixes            {*tcl\ sh*} {set winMode Csh}
  199. newModeVar Csh wordBreak {(\$)?[a-zA-Z0-9_]+} 0
  200. newModeVar Csh wordWrap {0} 1
  201. newModeVar Csh wordBreakPreface {[^a-zA-Z0-9_\$]} 0
  202. newModeVar Csh optionIsMeta {1} 1
  203. regModeKeywords -m {«} Csh {}
  204.  
  205. #================================================================================
  206. lappend modes Text
  207. set modeMenus(Text)                { }
  208. newModeVar Text suffixString { <--} 0
  209. newModeVar Text prefixString {> } 0
  210. newModeVar Text fillColumn {75} 0
  211. newModeVar Text wordWrap {1} 1
  212. newModeVar Text optionIsMeta {1} 1
  213.  
  214. #================================================================================
  215. # Updated Fortran mode definition:
  216. #
  217. # Changes are:    * .fcm suffix triggers Fort mode (CM-5 fortran)
  218. #                 * .for suffix triggers Fort mode (old compilers)
  219. #                * "entry" names are included in subroutine lists
  220. #                * prefix sting is set correctly (initial 'c')
  221. #                * FortMarkFile routine provided (funcExpr doesn't work anymore?)
  222. #
  223. # WTP 8/5/94
  224. #=============================================================================
  225. lappend modes Fort
  226. set modeMenus(Fort)             { }
  227. lappend modeSuffixes            {*.f} { set winMode Fort }
  228. lappend modeSuffixes            {*.fcm} { set winMode Fort }
  229. lappend modeSuffixes            {*.for} { set winMode Fort }
  230. lappend modeSuffixes            {*.FOR} { set winMode Fort }
  231. set FortmodeVars(wordWrap)        {0}
  232. set FortmodeVars(prefixString)    {c}
  233. set FortmodeVars(sortedIsDefault)        {0}
  234. set FortmodeVars(funcExpr)    {^[ \t]*(subroutine|.*function|entry|SUBROUTINE|.*FUNCTION|ENTRY).*\(.*$}
  235. set FortmodeVars(optionIsMeta)    {1}
  236.  
  237. set FortKeywords { 
  238.     backspace block call character close common complex 
  239.     continue data dimension do double else elseif end enddo endfile endif entry 
  240.     equivalence external format function goto if implicit inquire integer 
  241.     intrinsic logical open parameter precision print program read return save 
  242.     stop real rewind subroutine then write
  243. }
  244.  
  245. regModeKeywords -c red -k blue Fort $FortKeywords
  246. unset FortKeywords
  247.  
  248. #=============================================================================
  249.  
  250. proc FortMarkFile {} {
  251.     set pat1 {^[^cC][ \tA-Za-z*0-9]+(subroutine|function|entry)[ \t]*([A-Za-z0-9_]+)}
  252.     set end [maxPos]
  253.     set pos 0
  254.     set l {}
  255.     while {![catch {search -f 1 -r 1 -m 0 -i 1 $pat1 $pos} mtch]} {
  256.         regexp -nocase $pat1 [eval getText $mtch] allofit subtyp name
  257.         set start [lindex $mtch 0]
  258.         set end [nextLineStart $start]
  259.         set pos $end
  260.         set inds($name) [lineStart $start]
  261.     }
  262.  
  263.     if {[info exists inds]} {
  264.         foreach f [lsort [array names inds]] {
  265.             set next [nextLineStart $inds($f)]
  266.             setNamedMark $f $inds($f) $next $next
  267.         }
  268.     }
  269. }
  270.  
  271. #=============================================================================
  272. lappend modes Tcl
  273. set dummyProc(Tcl)                dummyTcl
  274. set modeMenus(Tcl)                 { tclMenu }
  275. lappend modeSuffixes            {*.tcl} { set winMode Tcl }
  276. newModeVar Tcl prefixString {# } 0
  277. newModeVar Tcl wordWrap {0} 1
  278. newModeVar Tcl funcExpr {^proc *([+-a-zA-Z0-9]+)} 0
  279. newModeVar Tcl wordBreak {(\$)?[a-zA-Z0-9_]+} 0
  280. newModeVar Tcl wordBreakPreface {([^a-zA-Z0-9_\$]|.\$)} 0
  281. newModeVar Tcl optionIsMeta {1} 1
  282. newModeVar Tcl electricTab {1} 1
  283.  
  284. set tclKeywords {
  285.     then append array break case catch cd close concat continue elseif else eof 
  286.     error eval exec exit expr file flush foreach format for gets global glob 
  287.     history if incr info join lappend library lindex linsert list llength 
  288.     lrange lreplace lsearch lsort open pid proc puts pwd read regexp regsub 
  289.     rename return scancontext scan seek set source split string switch tell 
  290.     time trace unknown unset uplevel upvar while
  291. }
  292. regModeKeywords -e {#} -c red -k blue Tcl $tclKeywords
  293. unset tclKeywords
  294.  
  295. #================================================================================
  296. lappend modes MPW
  297. set modeMenus(MPW)                 { }
  298. lappend modeSuffixes            {*Toolserver\ *} { set winMode MPW }
  299.  
  300. #================================================================================
  301. lappend modes Brws
  302. set modeMenus(Brws)             { }
  303. set dummyProc(Brws)                dummyBrws
  304. #================================================================================
  305. lappend modes Diff
  306. set modeMenus(Diff)             { }
  307. #================================================================================
  308.  
  309. proc buildFlagsVars {} {
  310.     global allFlags allVars modeVars
  311.     
  312.     set fs {}
  313.     foreach f [lsort $allFlags] {
  314.         if {[lsearch $modeVars $f] < 0} {
  315.             lappend fs $f
  316.         }
  317.     }
  318.     menu -m -n flags -p editFlag $fs
  319.     eval global $fs
  320.     foreach f $fs {
  321.         markMenuItem flags $f [set $f]
  322.     }
  323.  
  324.     set fs {}
  325.     foreach f [lsort $allVars] {
  326.         if {[lsearch $modeVars $f] < 0} {
  327.             lappend fs $f
  328.         }
  329.     }
  330.     menu -m -n vars -p editVar $fs
  331. }
  332.  
  333.  
  334. proc saveVarValues {} {
  335.     global modes HOME
  336.     if {[askyesno "Save variables and values to \"$HOME:alphaFlags.tcl\"?"] == "yes"} {
  337.         set lines {}
  338.         foreach m $modes {
  339.             global ${m}modeVars
  340.             
  341.             if {[info exists ${m}modeVars]} {
  342.                 foreach v [array names ${m}modeVars] {
  343.                     append lines "set ${m}modeVars($v)\t\t\{[set ${m}modeVars($v)]\}\r"
  344.                 }
  345.                 append lines "\r"
  346.             }
  347.         }
  348.         
  349.         append lines "\r\r"
  350.         global allFlags allVars
  351.         set vars [lsort [concat $allFlags $allVars]]
  352.         eval global $vars
  353.         foreach f $vars {
  354.             append lines "set $f\t\t\{[set $f]\}\r"
  355.         }
  356.  
  357.         set fd [open "$HOME:alphaFlags.tcl" "w"]
  358.         puts $fd $lines
  359.         close $fd
  360.         message "New '$HOME:alphaFlags.tcl' written."
  361.     }
  362. }
  363.  
  364.  
  365. #================================================================================
  366.  
  367. proc setWinMode name {
  368.     global winModes modeSuffixes
  369.     set nm [file tail $name]
  370.     if {[set first [string last " <" $nm]] >= 0} {
  371.         set rname [string range $nm 0 [expr $first - 1]]
  372.     } else {
  373.         set rname $nm
  374.     }
  375.     case $rname in $modeSuffixes
  376.     set winModes($name) $winMode
  377. }
  378.  
  379.  
  380.  
  381. proc newMode mode {
  382.     global winModes modeProcs
  383.     
  384.     set name [lindex [winNames -f] 0]
  385.     changeMode $mode
  386.     set winModes($name) $mode
  387. }
  388.  
  389.  
  390. proc deactivateHook name {
  391. }
  392.  
  393. proc suspendHook name {
  394.     global iconifyOnSwitch
  395.     global suspIconed
  396.     if {$iconifyOnSwitch} {
  397.         set wins [winNames -f]
  398.         foreach win $wins {
  399.             if {![icon -f "$win" -q]} {
  400.                 set suspIconed($win) 1
  401.                 icon -f "$win" -t
  402.             }
  403.         }
  404.     }
  405. }
  406.  
  407. proc resumeHook name {
  408.     global iconifyOnSwitch resumeRevert suspIconed
  409.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  410.         set wins [winNames -f]
  411.         foreach win [array names suspIconed] {
  412.             icon -f "$win" -o
  413.         }
  414.         unset suspIconed
  415.     }
  416.     if {$resumeRevert} {
  417.         set resumeRevert 0
  418.         revert
  419.     }
  420. }
  421.  
  422.  
  423.  
  424. # Handles dynamically adding and deleting window names from menu.
  425. proc addWinName name {
  426.     global winNameToNum winMenu winNumToName fullNames
  427.     
  428.     for {set i 0} {$i<100} {incr i} {
  429.         if {[catch {set nm $winNumToName($i)} res] == "1"} {
  430.             if {$fullNames != "0"} {
  431.                 set nm $name
  432.             } else {
  433.                 regexp {[^:]*$} $name nm
  434.             }
  435.             if {$i < 10} {
  436.                 addMenuItem -m -l "/$i" $winMenu $nm
  437.             } else {
  438.                 addMenuItem -m -l "" $winMenu $nm
  439.             }
  440.             set winNumToName($i) $name
  441.             set winNameToNum($name) $i
  442.             return
  443.         }
  444.     }
  445. }
  446.  
  447. proc removeWinName name {
  448.     global winNameToNum winNumToName fullNames winMenu
  449.     
  450.     set num $winNameToNum($name)
  451.     unset winNumToName($num)
  452.     unset winNameToNum($name)
  453.     if {$fullNames == "1"} {
  454.         deleteMenuItem -m $winMenu $name
  455.     } else {
  456.         regexp {[^:]*$} $name nm
  457.         deleteMenuItem -m $winMenu $nm
  458.     }
  459. }
  460.  
  461.  
  462. proc menuWin {menu name} {
  463.     global winNameToNum
  464.  
  465.     set nms [array names winNameToNum]
  466.     foreach nm $nms {
  467.         if {[string match *$name $nm] == "1"}  {
  468.             bringToFront $name
  469.             if [icon -q] { icon -f $name -o }
  470.             return
  471.         }
  472.     }
  473.     return "normal"
  474. }
  475.  
  476.  
  477.  
  478. proc changeMode {newMode} {
  479.     global lastMode modeMenus dummyProc mode
  480.     
  481.     catch {displayMode $newMode}
  482.     set lastMode $mode
  483.     set mode $newMode
  484.     if {$lastMode == $mode} return
  485.  
  486.     global ${mode}modeVars
  487.     if {[info exists ${mode}modeVars]} {
  488.         foreach v [array names ${mode}modeVars] {
  489.             global $v
  490.             set $v [set ${mode}modeVars($v)]
  491.         }
  492.     }
  493.  
  494.     if {[info exists dummyProc($mode)]} { $dummyProc($mode) }
  495.  
  496.     if {[info exists modeMenus($lastMode)]} {
  497.         foreach m $modeMenus($lastMode) {
  498.             global $m
  499.             catch {removeMenu [set $m]}
  500.         }
  501.     }
  502.     if {[info exists modeMenus($mode)]} {
  503.         foreach m $modeMenus($mode) {
  504.             global $m
  505.             catch {insertMenu [set $m]}
  506.         }
  507.     }
  508. }
  509.  
  510.  
  511. proc setModeMenus {} {
  512.     global mode modeMenus allModeMenus
  513.  
  514.     set menus [listpick -p "Select permanent menus for mode '$mode':" -l -L $modeMenus($mode) [lsort $allModeMenus]]
  515.     if {![llength $menus]} return
  516.     set modeMenus($mode) $menus
  517.     addUserLine "set modeMenus($mode) \{ $menus \}"
  518.  
  519.     foreach m $allModeMenus {
  520.         global $m
  521.         catch {removeMenu [set $m]}
  522.     }
  523.     foreach m $menus {
  524.         global $m
  525.         catch {insertMenu [set $m]}
  526.     }
  527. }
  528.  
  529.  
  530. #=============================================================================
  531. # Hook procs recognized: "openHook", "closeHook", "activateHook", "deactivateHook", 
  532. #                          "suspendHook", "saveasHook", "saveHook", and "resumeHook".
  533. #=============================================================================
  534.  
  535. if {![info exists winActive]} {set winActive ""}
  536.  
  537. # Event hooks - set specific modes when files opened.
  538. proc openHook name {
  539.     global winModes winActive
  540.     changeMode $winModes($name)
  541.     if {$name == {*Toolserver shell*}} startMPW
  542.     addWinName $name
  543.     message ""
  544. }
  545.  
  546.  
  547.  
  548. # full pathname
  549. proc saveHook name {
  550.     global backup backExtension backDir mode
  551.     
  552.     if {($mode == "C") || ($mode == "C++")} {catch {modified}}
  553.  
  554.     if ($backup) {
  555.         if {![string length [set dir $backDir]]} {
  556.             set dir [file dirname $name]
  557.         }
  558.         if {![file exists $dir]} {
  559.             if {[askyesno "Create backup dir '$dir'?"] == "yes"} {
  560.                 mkdir $dir
  561.             }
  562.         }
  563.         catch {rm $dir:[file tail $name]$backExtension}
  564.         catch {cp $name $dir:[file tail $name]$backExtension}
  565.     }
  566. }
  567.  
  568. # Clean up the mark stack.
  569. proc closeHook name {
  570.     global markStack winModes winActive
  571.  
  572.     unset winModes($name)
  573.     if [llength $markStack] {
  574.         set markStack [removePat $markStack $name*]
  575.     }
  576.     removeWinName $name
  577.  
  578.     if {[set ind [lsearch $winActive $name]] >= 0} {
  579.         set winActive [lreplace $winActive $ind $ind]
  580.     }
  581. }
  582.  
  583.  
  584. proc saveasHook {oldName newName} {
  585.     global winModes winActive
  586.     removeWinName $oldName
  587.     addWinName $newName
  588.     setWinMode $newName
  589.     changeMode $winModes($newName)
  590.     
  591.     if {[set ind [lsearch $winActive $oldName]] >= 0} {
  592.         set winActive [lreplace $winActive $ind $ind]
  593.     }
  594.     set winActive [linsert $winActive 0 $newName]
  595. }
  596.  
  597. if {![info exists actives]} {set actives 0}
  598.  
  599. # and, install a new 'winActive' patch , to 'activateHook':
  600.  
  601. proc activateHook name {
  602.     global winModes winActive
  603.     if {![info exists winModes($name)]} {
  604.         setWinMode $name
  605.     }
  606.     changeMode $winModes($name)
  607.  
  608.     if {[set ind [lsearch $winActive $name]] == -1} {
  609.         set winActive [linsert $winActive 0 $name]
  610.         return
  611.     }
  612.     if {$ind >= 1} {
  613.         set winActive [lreplace $winActive $ind $ind]
  614.         set winActive [linsert $winActive 0 $name]
  615.     }
  616.  
  617. }
  618.  
  619.  
  620. proc dirtyHook {name dirty} {
  621.     global winMenu
  622.     markMenuItem $winMenu [file tail $name] $dirty "◊"
  623. }
  624.  
  625.  
  626. set modifiedVars        {}
  627. set modifiedModeVars    {}
  628.  
  629. proc quitHook {} {
  630.     global modifiedVars modifiedModeVars
  631.  
  632.     if {[llength $modifiedVars] || [llength $modifiedModeVars} {
  633.         if {[askyesno "Save changed flags/vars?"] == "yes"} {
  634.             foreach f $modifiedVars {
  635.                 global $f
  636.                 addUserLine "set $f \"[set $f]\""
  637.             }
  638.             foreach f $modifiedModeVars {
  639.                 set nm [lindex $f 0]
  640.                 set mode [lindex $f 1]
  641.                 global $mode
  642.                 addUserLine "set ${mode}($nm) \"[set $mode($nm)]\""
  643.             }
  644.         }
  645.     }
  646. }
  647.  
  648.  
  649. #================================================================================
  650.  
  651. proc describeMode {} {
  652.     global mode modeSuffixes modeMenus modes
  653.     global ${mode}modeVars
  654.     
  655.     set text "\r\tMODE $mode\r\r"
  656.     set suffs ""
  657.     set first 1
  658.     foreach suf $modeSuffixes {
  659.         if {([llength $suf] == 3) && ([lindex $suf 1] == "winMode") && ([lindex $suf 2] == $mode)} {
  660.             if {$first} {
  661.                 lappend suffs $last
  662.                 set first 0
  663.             } else {
  664.                 append suffs ", $last"
  665.             }
  666.         }
  667.         set last $suf
  668.     }
  669.     append text "Mode suffixes: $suffs\r\r"
  670.     
  671.     set first 1
  672.     append text "Mode menus: "
  673.     if {[info exists modeMenus($mode)]} {
  674.         foreach m $modeMenus($mode) {
  675.             if $first {
  676.                 set first 0
  677.                 lappend text $m
  678.             } else {
  679.                 append text ", $m"
  680.             }
  681.         }
  682.     }
  683.     append text "\r\r"
  684.  
  685.     append text "Mode-specific variables:\r"
  686.     if {[info exists ${mode}modeVars]} {
  687.         foreach v [lsort [array names ${mode}modeVars]] {
  688.             append text [format "\t%-20s: \"%s\"\r" $v [set ${mode}modeVars($v)]]
  689.         }
  690.     }
  691.  
  692.  
  693.     set etext "\rMode-independent bindings:\r"
  694.     append text "\rMode-specific bindings:\r"
  695.     foreach b [split [bindingList] "\r"] {
  696.         set lst [lindex $b end]
  697.         if {$lst == $mode} {
  698.             append text "\t$b\r"
  699.         } elseif {[lsearch $modes $lst] < 0} {
  700.             append etext "\t$b\r"
  701.         }
  702.     }
  703.     new
  704.     insertText $text$etext
  705.     goto 0
  706.     
  707.     setWinInfo dirty 0
  708. }
  709.  
  710.  
  711.